# loading packages
if (!require(tidyverse)) {
install.packages('tidyverse')
}
if (!require(lmerTest)) {
install.packages('lmerTest')
}
library(specr)
library(mediation)
library(dplyr)
library(pander)
library(gridExtra)
# defining palette
palette_cond = wesanderson::wes_palette("Zissou1", n = 2, type = "continuous")
palette_cond = c(palette_cond[1:2], "black")
palette = c(palette_cond[1:3], "grey50")
# Data was cleaned using the `../data_cleaning.Rmd` script.
data_pilot1 = read.csv("../../covid19_study1_pilot/covid19_study1_pilot_clean_long.csv", stringsAsFactors = FALSE)
data_pilot2 = read.csv("../../covid19_study1_pilot2/covid19_study1_pilot2_clean_long.csv", stringsAsFactors = FALSE)
data_combined = read.csv("../../covid19_study1_pilot/covid19_study1_pilot_clean_long.csv", stringsAsFactors = FALSE) %>%
bind_rows(read.csv("../../covid19_study1_pilot2/covid19_study1_pilot2_clean_long.csv", stringsAsFactors = FALSE)) %>%
mutate(SID = sprintf("%s_%s", study, SID))The overarching goal of this project is to determine the degree to which several message framing interventions might enhance message effectiveness and intentions, norms, and beliefs related to social distancing. Specifically, here we test the effect of humorous framing of health messages promoting social distancing behavior. We use two types of humorous framings:
Participants were randomly assigned to either a message framing intervention group (using encouraging or mocking humor), a control message group, or a group that saw no messages. Each participant in the intervention and message control groups saw a series of 5 messages about social distancing related to COVID-19 randomly sampled from a pool of 15 messages for pilot 2, which previously normed for argument strength (M = 4.16, SD = 0.14, possible range = 1-5). Each message was created to look like an instagram post that included a visual message about COVID-19 accompanied by a “post” about the message.The message control condition contained this stem only, whereas the humorous-framing conditions contained additional text framing the messages humorously (i.e., adding a joke, using the stem as premise). Particpants then completed various outcome and individual differences measures.
We ran two short pre-tests to test our intended manipulations of funniness and mockingness in the non-mocking and mocking humorous texts we designed. For non-mocking messages, we recuited 32 participants, and for mocking messages, we recruited 37 participants. Participants were asked to rate how funny (1 = Not at all funny, 5 = Extremely funny) and mocking (1 =Not at all mocking, 5 = Extremely mocking) these humorous texts were.
df <- read.csv('pretest1/COVID-19 humorous messages testing_March 26, 2020_20.08.csv')
### Extract variable name data
varnames<- df[1:2,]
df <- df[3:dim(df)[1],]
### Filter based on progress
df$Progress<- as.numeric(as.character(df$Progress))
df <- df[df$Progress >= 90,]
### Recoding values
recoding_cols <- colnames(df)[11:198]
for (c in recoding_cols) {
df[,c] <- recode(df[,c], `Not at all funny` = 1, `A bit funny` = 2, `Somewhat funny` = 3, `Very funny` = 4, `Extremely funny` = 5, `Not at all mocking` = 1, `A bit mocking` = 2, `Somewhat mocking` = 3, `Very mocking` = 4, `Extremely mocking` = 5)
}
### Extract encouraging (non-mocking) messages
df_enc <- df %>%
dplyr::select(!matches("^moc_")) %>%
mutate(attention_check = enc_1.1_11 == 3 & enc_1.2_11 == 1 &
enc_3.1_11 == 5 & enc_3.2_11 == 2 &
enc_5.1_10 == 1 & enc_5.2_10 == 3) %>% # attention checks
filter(attention_check == TRUE) %>%
dplyr::select(-enc_1.1_11, -enc_1.2_11, -enc_3.1_11, -enc_3.2_11, -enc_5.1_10, -enc_5.2_10) # removing attention check variables
### convert from wide to long form
df_enc <- df_enc %>%
dplyr::select(matches("enc_")) %>%
mutate(SID = sprintf("S%02d", seq.int(nrow(.)))) %>%
gather("item", "score", -SID) %>%
extract(item, c("block", "question_type", "msg_number"), "enc_([1-5]).([1-2])_([0-9]+)", remove = TRUE) %>%
mutate(item = sprintf("enc_%s_%s", block, msg_number)) %>%
mutate(question_type = ifelse(question_type == 1, "funniness",
ifelse(question_type == 2, "mocking", "other"))) %>%
dplyr::select(SID, item, question_type, score) %>%
spread(question_type, score)
### load item texts and merge with data frame
item_texts <- read.csv('pretest1/encouraging_stim.csv') %>%
dplyr::select(item, text, image)
df_enc <- df_enc %>%
left_join(., item_texts, by = "item")
############################################
# Loading data and formatting it to make it analyzable
df <- read.csv('pretest2/COVID-19 humorous messages testing (mocking only)_March 31, 2020_18.26.csv')
### Extract variable name data
varnames<- df[1:2,]
df <- df[3:dim(df)[1],]
### Filter based on progress
df$Progress<- as.numeric(as.character(df$Progress))
df <- df[df$Progress >= 90,]
### Recoding values
recoding_cols <- colnames(df)[11:64]
for (c in recoding_cols) {
df[,c] <- recode(df[,c], `Not at all funny` = 1, `A bit funny` = 2, `Somewhat funny` = 3, `Very funny` = 4, `Extremely funny` = 5, `Not at all mocking` = 1, `A bit mocking` = 2, `Somewhat mocking` = 3, `Very mocking` = 4, `Extremely mocking` = 5)
}
### Removing unwanted columns
df <- df[,c("ResponseId", recoding_cols)]
### Filtering based on attention checks
df$attention_check <- df$att_check_funniness == 4 & df$att_check_mocking == 3 &
df$att_check_funniness.1 == 1 & df$att_check_mocking.1 == 4
df <- df[df$attention_check,]
### Removing attention check variables
df$att_check_funniness <- NULL
df$att_check_funniness.1 <- NULL
df$att_check_mocking <- NULL
df$att_check_mocking.1 <- NULL
df$attention_check <- NULL
### convert from wide to long form
list_items <- colnames(df)[2:51]
df <- df %>%
gather(key = "item", value = "value", list_items) %>%
separate(item, c("image", "joke_number", "rating_type")) %>%
unite("item", c("image", "joke_number")) %>%
spread(rating_type, value)
### extracting list of joke texts
varnames <- varnames[1,list_items]
varnames <- varnames %>%
gather(key = "item", value = "text") %>%
separate(item, c("image", "joke_number", "rating_type")) %>%
unite("item", c("image", "joke_number"))
varnames <- varnames[varnames$rating_type == "funniness",]
varnames <- varnames %>%
separate(text, c("remove_this", "joke_text"), sep = " - Please indicate how funny you find the following messages. - ") %>%
separate(item, c("remove_this2", "item"), sep = "X")
varnames$remove_this <- NULL
varnames$remove_this2 <- NULL
varnames$rating_type <- NULL
### merge joke texts with the data
df <- df %>%
separate(item, c("remove_this", "item"), sep = "X") %>%
dplyr::select(-remove_this)
df_mock <- merge(df, varnames, by = "item")
rm(df)p1 <- df_enc %>%
mutate(funniness = as.numeric(funniness)) %>%
ggplot(aes(funniness, item)) +
ggridges::geom_density_ridges2(alpha = .6, fill = palette_cond[2]) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top") +
ylab("Non-mocking humorous text id") +
labs(title = "Non-mocking messages")
p2 <- df_mock %>%
mutate(funniness = as.numeric(funniness)) %>%
ggplot(aes(funniness, item)) +
ggridges::geom_density_ridges2(alpha = .6, fill = palette_cond[2]) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top") +
ylab("Mocking humorous text id") +
labs(title = "Mocking messages")
grid.arrange(p1, p2, nrow=1)p1 <- df_enc %>%
mutate(mocking = as.numeric(mocking)) %>%
ggplot(aes(mocking, item)) +
ggridges::geom_density_ridges2(alpha = .6, fill = palette_cond[2]) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top") +
ylab("Non-mocking humorous text id") +
labs(title = "Non-mocking messages")
p2 <- df_mock %>%
mutate(mocking = as.numeric(mocking)) %>%
ggplot(aes(mocking, item)) +
ggridges::geom_density_ridges2(alpha = .6, fill = palette_cond[2]) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top") +
ylab("Mocking humorous text id") +
labs(title = "Mocking messages")
grid.arrange(p1, p2, nrow=1)NOTE: In the pilots and subsequent studies, the stimuli are images paired with texts in the format of an Instagram post. We work with an initial set of 33 images, and each pretested humorous text corresponds to the one of these images. The image indices corresponding to the texts are mentioned in these tables.
### average funniness and mocking scores per message
df_enc_final <- df_enc %>%
group_by(item) %>%
summarise(funniness_mean = mean(funniness, na.rm=T),
mocking_mean = mean(mocking, na.rm=T)) %>%
left_join(., item_texts, by = "item") %>%
arrange(desc(funniness_mean))
df_enc_final %>%
dplyr::select(image, text, funniness_mean, mocking_mean) %>%
DT::datatable()For each image number, we selected the joke text with the highest funniness rating.
df_items <- df_mock %>%
group_by(item) %>%
summarise(funniness = mean(funniness), mocking = mean(mocking))
df_items <- merge(df_items, varnames, by = "item")
df_items %>%
extract(item, c("image", "iter"), "([0-9]+)_([0-9]+)", remove = F) %>%
dplyr::select(image, item, joke_text, funniness, mocking) %>%
arrange(desc(funniness)) %>%
DT::datatable()For each image number, we selected the joke text with the highest funniness rating.
df_final_set <- df_items %>%
separate(item, c("image", "joke_number"), sep = "_") %>%
mutate(image = as.numeric(image)) %>%
mutate(joke_number = as.numeric(joke_number)) %>%
group_by(image) %>%
filter(funniness == max(funniness)) #%>%
df_final_set %>%
dplyr::select(image, joke_text, funniness, mocking) %>%
arrange(desc(funniness)) %>%
DT::datatable()Selection of messages for pilot studies
For Pilot 1, we selected texts which had a funniness rating of more than 2 (which corresponded to “a bit funny”), and for each image, we selected the corresponding humorous text (only non-mocking) with the highest funniness score. For Pilot 2, we selected humorous texts (both mocking and non-mocking) which were about social distancing and had a score greater than 1.9 (making the threshold of 2 a bit lenient to accommodate more stimuli), resulting in 12 non-mocking messages and 13 mocking messages.
Here, we test the effect of “encouraging” humor versus message control, which were non-humorous. Encouraging humor refers to humorous framing of health messages such that these messages were not overtly mocking any person or group of people.
## tidy data for analysis
data = data_pilot1
messages = data %>%
filter(condition %in% c("message control", "encouraging")) %>%
filter(grepl("msg", survey_name)) %>%
mutate(value = as.numeric(value),
value = ifelse(item == "cognition_2", abs(6 - value), value),
value = ifelse(item == "cognition_4", abs(6 - value), value),
value = ifelse(item == "cognition_6", abs(6 - value), value)) %>%
extract(item, "item", "msg_.*_(.*)") %>%
spread(survey_name, value) %>%
mutate(msg_favorability = msg_positive - msg_negative) %>%
dplyr::select(-msg_negative, -msg_positive) %>%
gather(survey_name, value, contains("msg")) %>%
mutate(item = sprintf("%s_%s", survey_name, item))
data_tidy = data %>%
filter(condition %in% c("message control", "encouraging")) %>%
mutate(condition = str_replace(condition, "-paired|-unpaired", "")) %>%
filter(grepl("cognition|intentions|norms_close|norms_town|beliefs|beliefs|politics_party|politics_conserv|^age$|gender", survey_name)) %>%
mutate(value = as.numeric(value)) %>%
bind_rows(messages)
control_vars = data %>%
filter(grepl("state|gender|^age$", survey_name)) %>%
dplyr::select(condition, SID, survey_name, value) %>%
unique() %>%
spread(survey_name, value) %>%
mutate(state = as.factor(state),
gender = recode(gender, "1" = "male", "2" = "female", "3" = "other", "4" = "prefer not to say"),
age = scale(as.numeric(age), center = TRUE, scale = FALSE))
data_person = data_tidy %>%
filter(grepl("msg|cognition|beliefs|intentions1_2|intentions1_4|intentions1_6|intentions1_10|norms_close1_2|norms_close1_4|norms_close1_6|norms_close1_10|norms_town1_2|norms_town1_4|norms_town1_6|norms_town1_10|politics_party|politics_conserv", item)) %>%
group_by(condition, SID, survey_name) %>%
summarize(value = mean(value, na.rm = TRUE))data_person %>%
dplyr::select(SID, condition) %>%
unique() %>%
group_by(condition) %>%
summarise(n = n())plot_cond = function(data, survey, item=TRUE, palette=palette) {
if (item == FALSE){
data %>%
filter(grepl(!!(survey), survey_name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(survey_name, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
scale_color_manual(values = palette) +
labs(x = "", y = "value\n") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
} else {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(item, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
scale_color_manual(values = palette) +
labs(x = "", y = "value\n") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
}
}
plot_compare = function(data, survey = ".*", palette, condition = FALSE) {
rating_means = data %>%
filter(grepl(!!(survey), survey_name)) %>%
group_by(survey_name) %>%
summarize(mean = mean(value))
if (condition == TRUE) {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
ggplot(aes(message, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot") +
coord_flip() +
geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
facet_grid(~survey_name) +
labs(x = "message\n", y = "\nvalue") +
scale_color_manual(values = palette_cond) +
theme_minimal() +
theme(legend.position = "top")
} else {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
ggplot(aes(message, value)) +
stat_summary(fun.data = "mean_cl_boot") +
coord_flip() +
geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
facet_grid(~survey_name) +
labs(x = "message\n", y = "\nvalue") +
scale_color_manual(values = palette_cond) +
theme_minimal() +
theme(legend.position = "top")
}
}
data_comp = messages %>%
filter(!survey_name == "msg_familiarity") %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE)A summary of condition effects on message level ratings for each of the 15 messages tested in this study.
A summary of condition effects on message ratings and other DVs/covariates at person level.
A summary of condition effects on each survey item.
A summary of condition effects on each survey, aggregated across survey items.
dvs_covs = data_person %>%
filter(grepl("intentions|cognition|norms|beliefs", survey_name)) %>%
group_by(survey_name) %>%
mutate(value = scale(value)) %>% #scale within survey
spread(survey_name, value)
data_mod = messages %>%
group_by(SID, survey_name) %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
mutate(trial = row_number()) %>%
dplyr::select(-item) %>%
group_by(survey_name) %>%
mutate(value = scale(value)) %>% #scale within survey
spread(survey_name, value) %>%
left_join(., dvs_covs) %>%
mutate(condition = factor(condition, levels = c("message control", "encouraging", "mocking")),
SID = as.factor(SID)) %>%
ungroup() %>%
dplyr::select(-msg_familiarity)
data_mod_person = messages %>%
group_by(SID, survey_name) %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
mutate(trial = row_number()) %>%
dplyr::select(-item) %>%
group_by(study, condition, SID, survey_name, survey_name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>% # take the mean across messages
group_by(survey_name) %>%
mutate(value = scale(value)) %>% # scale across people
spread(survey_name, value) %>%
left_join(., dvs_covs)Models = lmer(DV ~ condition + (1 | SID) + (1 | message), data = data_mod)
motiv_self_1 = lmer(msg_motiv_self ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
motiv_other_1 = lmer(msg_motiv_other ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
rel_social_1 = lmer(msg_rel_social ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
share_1 = lmer(msg_share ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
favorability_1 = lmer(msg_favorability ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
cognition_1 = lm(cognition ~ condition, data = data_mod_person)
intentions_1 = lm(intentions1 ~ condition, data = data_mod_person)
norms_close_1 = lm(norms_close1 ~ condition, data = data_mod_person)
norms_town_1 = lm(norms_town1 ~ condition, data = data_mod_person)
beliefs_1 = lm(beliefs ~ condition, data = data_mod_person)| Estimate | Std. Error | df | t value | Pr(>|t|) | |
|---|---|---|---|---|---|
| (Intercept) | -0.09288 | 0.189 | 28 | -0.4913 | 0.627 |
| conditionencouraging | 0.2143 | 0.2871 | 28 | 0.7464 | 0.4616 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.2723 | 0.2739 | 0.9945 | 0.3285 |
| conditionmessage control | -0.4806 | 0.3638 | -1.321 | 0.1972 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.08179 | 0.2815 | 0.2906 | 0.7735 |
| conditionmessage control | -0.1443 | 0.374 | -0.386 | 0.7024 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.3322 | 0.2697 | 1.232 | 0.2282 |
| conditionmessage control | -0.5862 | 0.3582 | -1.636 | 0.1129 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.1218 | 0.2806 | -0.434 | 0.6676 |
| conditionmessage control | 0.2149 | 0.3728 | 0.5765 | 0.5689 |
Models = lmer(DV ~ condition x cognition + (1 | SID) + (1 | message), data = data_mod)
motiv_self_2 = lmer(msg_motiv_self ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
motiv_other_2 = lmer(msg_motiv_other ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
rel_social_2 = lmer(msg_rel_social ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
share_2 = lmer(msg_share ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
favorability_2 = lmer(msg_favorability ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
intentions_2 = lm(intentions1 ~ condition*cognition, data = data_mod_person)
norms_close_2 = lm(norms_close1 ~ condition*cognition, data = data_mod_person)
norms_town_2 = lm(norms_town1 ~ condition*cognition, data = data_mod_person)| Estimate | Std. Error | df | t value | |
|---|---|---|---|---|
| (Intercept) | -0.1091 | 0.209 | 26 | -0.5221 |
| conditionencouraging | 0.3417 | 0.3259 | 26 | 1.049 |
| cognition | 0.04412 | 0.2194 | 26 | 0.2011 |
| conditionencouraging:cognition | 0.1865 | 0.3287 | 26 | 0.5674 |
| Pr(>|t|) | |
|---|---|
| (Intercept) | 0.606 |
| conditionencouraging | 0.304 |
| cognition | 0.8422 |
| conditionencouraging:cognition | 0.5753 |
| Estimate | Std. Error | df | t value | |
|---|---|---|---|---|
| (Intercept) | 0.0477 | 0.2132 | 25.77 | 0.2238 |
| conditionencouraging | -0.02268 | 0.3319 | 25.99 | -0.06832 |
| cognition | -0.01703 | 0.2235 | 26 | -0.07621 |
| conditionencouraging:cognition | 0.1817 | 0.3348 | 26 | 0.5428 |
| Pr(>|t|) | |
|---|---|
| (Intercept) | 0.8247 |
| conditionencouraging | 0.9461 |
| cognition | 0.9398 |
| conditionencouraging:cognition | 0.5919 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.2613 | 0.3221 | 0.8113 | 0.4246 |
| conditionmessage control | -0.4871 | 0.4199 | -1.16 | 0.2566 |
| cognition | -0.02284 | 0.3153 | -0.07243 | 0.9428 |
| conditionmessage control:cognition | 0.07023 | 0.4235 | 0.1659 | 0.8696 |
mod1 = lm(norm_close ~ condition, data = data_mod_person)
mod2 = lm(DV ~ norm_close + condition, data = data_mod_person)
mediation_mod = mediate(mod1, mod2, sims=1000, treat=“condition”, mediator=“mediator”)
num_sims = 1000
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_motiv_self ~ norms_close1 + condition, data = data_mod_person)
motiv_self_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_motiv_other ~ norms_close1 + condition, data = data_mod_person)
motiv_other_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_rel_social ~ norms_close1 + condition, data = data_mod_person)
rel_social_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_share ~ norms_close1 + condition, data = data_mod_person)
share_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_favorability ~ norms_close1 + condition, data = data_mod_person)
favorability_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(intentions1 ~ norms_close1 + condition, data = data_mod_person)
intentions_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME -0.0364 -0.3241 0.21 0.74
## ADE -0.2237 -0.9475 0.49 0.56
## Total Effect -0.2601 -0.9872 0.47 0.52
## Prop. Mediated 0.0641 -2.2194 3.17 0.71
##
## Sample Size Used: 30
##
##
## Simulations: 1000
##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME -0.01468 -0.21356 0.18 0.86
## ADE 0.13878 -0.58516 0.87 0.70
## Total Effect 0.12410 -0.63850 0.90 0.76
## Prop. Mediated 0.00781 -1.93115 1.79 0.93
##
## Sample Size Used: 30
##
##
## Simulations: 1000
##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME -0.0544 -0.4079 0.25 0.74
## ADE -0.4078 -1.0948 0.25 0.24
## Total Effect -0.4622 -1.2241 0.27 0.23
## Prop. Mediated 0.1028 -1.4979 2.50 0.64
##
## Sample Size Used: 30
##
##
## Simulations: 1000
Here, we test the effect of “encouraging” and “mocking” humor versus message control, which were non-humorous. Mocking humor refers to to humorous framing of health messages such that these messages were ridiculing individuals who would choose to not follow COVID-19 related preventative measures (like social distancing), even though their circumstances allow them to follow those measures. In contrast, encouraging messages used humorous framings which did not overtly mock or ridicule any person or group of people. In this study, we used the following sets of stimuli:
In this analysis, we combine mocking-paired and mocking-unpaired into “mocking” condition, and similarly, we combine encouraging-paired and encouraging-unpaired into “encouraging” condition.
## tidy data for analysis
data = data_pilot2
messages = data %>%
filter(condition %in% c("message control", "encouraging-unpaired", "encouraging-paired",
"mocking-unpaired", "mocking-paired")) %>%
mutate(condition = str_replace(condition, "-paired|-unpaired", "")) %>%
filter(grepl("msg", survey_name)) %>%
mutate(value = as.numeric(value),
value = ifelse(item == "cognition_2", abs(6 - value), value),
value = ifelse(item == "cognition_4", abs(6 - value), value),
value = ifelse(item == "cognition_6", abs(6 - value), value)) %>%
extract(item, "item", "msg_.*_(.*)") %>%
spread(survey_name, value) %>%
mutate(msg_favorability = msg_positive - msg_negative) %>%
dplyr::select(-msg_negative, -msg_positive) %>%
gather(survey_name, value, contains("msg")) %>%
mutate(item = sprintf("%s_%s", survey_name, item))
data_tidy = data %>%
filter(condition %in% c("message control", "encouraging-unpaired", "encouraging-paired",
"mocking-unpaired", "mocking-paired")) %>%
mutate(condition = str_replace(condition, "-paired|-unpaired", "")) %>%
filter(grepl("cognition|intentions|norms_close|norms_town|beliefs_safe|beliefs_norms|politics_party|politics_conserv|^age$|gender", survey_name)) %>%
mutate(value = as.numeric(value)) %>%
bind_rows(messages)
control_vars = data %>%
filter(grepl("state|gender|^age$", survey_name)) %>%
dplyr::select(condition, SID, survey_name, value) %>%
unique() %>%
spread(survey_name, value) %>%
mutate(state = as.factor(state),
gender = recode(gender, "1" = "male", "2" = "female", "3" = "other", "4" = "prefer not to say"),
age = scale(as.numeric(age), center = TRUE, scale = FALSE))
data_person = data_tidy %>%
filter(grepl("msg|cognition|beliefs|intentions1_2|intentions1_4|intentions1_6|intentions1_10|norms_close1_2|norms_close1_4|norms_close1_6|norms_close1_10|norms_town1_2|norms_town1_4|norms_town1_6|norms_town1_10|politics_party|politics_conserv", item)) %>%
group_by(condition, SID, survey_name) %>%
summarize(value = mean(value, na.rm = TRUE))data_person %>%
dplyr::select(SID, condition) %>%
unique() %>%
group_by(condition) %>%
summarise(n = n())plot_cond = function(data, survey, item=TRUE, palette=palette) {
if (item == FALSE){
data %>%
filter(grepl(!!(survey), survey_name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(survey_name, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
scale_color_manual(values = palette) +
labs(x = "", y = "value\n") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
} else {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
mutate(value = as.numeric(value)) %>%
ggplot(aes(item, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", position = position_dodge(width = .5)) +
scale_color_manual(values = palette) +
labs(x = "", y = "value\n") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top")
}
}
plot_compare = function(data, survey = ".*", palette, condition = FALSE) {
rating_means = data %>%
filter(grepl(!!(survey), survey_name)) %>%
group_by(survey_name) %>%
summarize(mean = mean(value))
if (condition == TRUE) {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
ggplot(aes(message, value, color = condition)) +
stat_summary(fun.data = "mean_cl_boot") +
coord_flip() +
geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
facet_grid(~survey_name) +
labs(x = "message\n", y = "\nvalue") +
scale_color_manual(values = palette_cond) +
theme_minimal() +
theme(legend.position = "top")
} else {
data %>%
filter(grepl(!!(survey), survey_name)) %>%
ggplot(aes(message, value)) +
stat_summary(fun.data = "mean_cl_boot") +
coord_flip() +
geom_hline(data = rating_means, aes(yintercept = mean), linetype = "dotted") +
facet_grid(~survey_name) +
labs(x = "message\n", y = "\nvalue") +
scale_color_manual(values = palette_cond) +
theme_minimal() +
theme(legend.position = "top")
}
}
data_comp = messages %>%
filter(!survey_name == "msg_familiarity") %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE)A summary of condition effects on message level ratings for each of the 15 messages tested in this study.
A summary of condition effects on message ratings and other DVs/covariates at person level.
A summary of condition effects on each survey item.
A summary of condition effects on each survey, aggregated across survey items.
dvs_covs = data_person %>%
filter(grepl("intentions|cognition|norms|beliefs", survey_name)) %>%
group_by(survey_name) %>%
mutate(value = scale(value)) %>% #scale within survey
spread(survey_name, value)
data_mod = messages %>%
group_by(SID, survey_name) %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
mutate(trial = row_number()) %>%
dplyr::select(-item) %>%
group_by(survey_name) %>%
mutate(value = scale(value)) %>% #scale within survey
spread(survey_name, value) %>%
left_join(., dvs_covs) %>%
mutate(condition = factor(condition, levels = c("message control", "encouraging", "mocking")),
SID = as.factor(SID)) %>%
ungroup() %>%
dplyr::select(-msg_familiarity)
data_mod_person = messages %>%
group_by(SID, survey_name) %>%
extract(item, "message", "msg_.*_([0-9]{2})", remove = FALSE) %>%
mutate(trial = row_number()) %>%
dplyr::select(-item) %>%
group_by(study, group, condition, SID, survey_name, survey_name) %>%
summarize(value = mean(value, na.rm = TRUE)) %>% # take the mean across messages
group_by(survey_name) %>%
mutate(value = scale(value)) %>% # scale across people
spread(survey_name, value) %>%
left_join(., dvs_covs)Models = lmer(DV ~ condition + (1 | SID) + (1 | message), data = data_mod)
motiv_self_1 = lmer(msg_motiv_self ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
motiv_other_1 = lmer(msg_motiv_other ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
rel_social_1 = lmer(msg_rel_social ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
share_1 = lmer(msg_share ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
favorability_1 = lmer(msg_favorability ~ condition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
cognition_1 = lm(cognition ~ condition, data = data_mod_person)
intentions_1 = lm(intentions1 ~ condition, data = data_mod_person)
norms_close_1 = lm(norms_close1 ~ condition, data = data_mod_person)
norms_town_1 = lm(norms_town1 ~ condition, data = data_mod_person)
beliefs_safe_others_1 = lm(beliefs_safe_others ~ condition, data = data_mod_person)
beliefs_safe_self_1 = lm(beliefs_safe_self ~ condition, data = data_mod_person)| Estimate | Std. Error | df | t value | Pr(>|t|) | |
|---|---|---|---|---|---|
| (Intercept) | 0.1759 | 0.1372 | 70.03 | 1.282 | 0.2041 |
| conditionencouraging | -0.1304 | 0.2168 | 70.23 | -0.6016 | 0.5494 |
| conditionmocking | -0.4119 | 0.2057 | 70.07 | -2.002 | 0.04914 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.07621 | 0.2258 | -0.3376 | 0.7367 |
| conditionmessage control | 0.02089 | 0.2914 | 0.07167 | 0.9431 |
| conditionmocking | 0.2089 | 0.3057 | 0.6833 | 0.4966 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.4682 | 0.2143 | -2.185 | 0.03221 |
| conditionmessage control | 0.4793 | 0.2767 | 1.732 | 0.08755 |
| conditionmocking | 0.8445 | 0.2902 | 2.91 | 0.004819 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.4389 | 0.2135 | -2.056 | 0.04348 |
| conditionmessage control | 0.3906 | 0.2756 | 1.417 | 0.1608 |
| conditionmocking | 0.865 | 0.2891 | 2.993 | 0.003803 |
Models = lmer(DV ~ condition x cognition + (1 | SID) + (1 | message), data = data_mod)
motiv_self_2 = lmer(msg_motiv_self ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
motiv_other_2 = lmer(msg_motiv_other ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
rel_social_2 = lmer(msg_rel_social ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
share_2 = lmer(msg_share ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
favorability_2 = lmer(msg_favorability ~ condition*cognition + (1 | SID) + (1 | message),
data = data_mod,
control = lmerControl(optimizer = "bobyqa"))
intentions_2 = lm(intentions1 ~ condition*cognition, data = data_mod_person)
norms_close_2 = lm(norms_close1 ~ condition*cognition, data = data_mod_person)
norms_town_2 = lm(norms_town1 ~ condition*cognition, data = data_mod_person)| Estimate | Std. Error | df | t value | |
|---|---|---|---|---|
| (Intercept) | 0.1762 | 0.1397 | 67.17 | 1.261 |
| conditionencouraging | -0.1303 | 0.2208 | 67.33 | -0.5901 |
| conditionmocking | -0.4115 | 0.2094 | 67.19 | -1.965 |
| cognition | -0.04103 | 0.129 | 67.99 | -0.318 |
| conditionencouraging:cognition | 0.05924 | 0.282 | 67.9 | 0.21 |
| conditionmocking:cognition | -0.04964 | 0.1926 | 67.93 | -0.2578 |
| Pr(>|t|) | |
|---|---|
| (Intercept) | 0.2116 |
| conditionencouraging | 0.5571 |
| conditionmocking | 0.05354 |
| cognition | 0.7515 |
| conditionencouraging:cognition | 0.8343 |
| conditionmocking:cognition | 0.7973 |
| Estimate | Std. Error | df | t value | |
|---|---|---|---|---|
| (Intercept) | 0.1701 | 0.1432 | 67.68 | 1.187 |
| conditionencouraging | -0.1317 | 0.2255 | 69.01 | -0.5839 |
| conditionmocking | -0.3833 | 0.2141 | 68.92 | -1.79 |
| cognition | 0.0277 | 0.1303 | 68.01 | 0.2125 |
| conditionencouraging:cognition | 0.121 | 0.2847 | 67.79 | 0.425 |
| conditionmocking:cognition | 0.008489 | 0.1944 | 67.86 | 0.04367 |
| Pr(>|t|) | |
|---|---|
| (Intercept) | 0.2392 |
| conditionencouraging | 0.5612 |
| conditionmocking | 0.07788 |
| cognition | 0.8323 |
| conditionencouraging:cognition | 0.6722 |
| conditionmocking:cognition | 0.9653 |
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | -0.07243 | 0.2295 | -0.3155 | 0.7533 |
| conditionmessage control | 0.01704 | 0.2963 | 0.05753 | 0.9543 |
| conditionmocking | 0.206 | 0.3107 | 0.6629 | 0.5096 |
| cognition | 0.1704 | 0.3367 | 0.5061 | 0.6144 |
| conditionmessage control:cognition | -0.1636 | 0.3786 | -0.4322 | 0.667 |
| conditionmocking:cognition | -0.3041 | 0.3875 | -0.7848 | 0.4353 |
mod1 = lm(norm_close ~ condition, data = data_mod_person)
mod2 = lm(DV ~ norm_close + condition, data = data_mod_person)
mediation_mod = mediate(mod1, mod2, sims=1000, treat=“condition”, mediator=“mediator”)
num_sims = 1000
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_motiv_self ~ norms_close1 + condition, data = data_mod_person)
motiv_self_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_motiv_other ~ norms_close1 + condition, data = data_mod_person)
motiv_other_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_rel_social ~ norms_close1 + condition, data = data_mod_person)
rel_social_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_share ~ norms_close1 + condition, data = data_mod_person)
share_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(msg_favorability ~ norms_close1 + condition, data = data_mod_person)
favorability_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")
mod1 <- lm(norms_close1 ~ condition, data = data_mod_person)
mod2 <- lm(intentions1 ~ norms_close1 + condition, data = data_mod_person)
intentions_3 <- mediate(mod1, mod2, sims=num_sims, treat="condition", mediator="norms_close1")##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.0552 -0.0772 0.23 0.39
## ADE 0.1085 -0.4601 0.69 0.73
## Total Effect 0.1637 -0.3880 0.72 0.56
## Prop. Mediated 0.0693 -3.5615 2.77 0.75
##
## Sample Size Used: 74
##
##
## Simulations: 1000
##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.0472 -0.0793 0.23 0.51
## ADE 0.1263 -0.4847 0.65 0.63
## Total Effect 0.1735 -0.3864 0.70 0.52
## Prop. Mediated 0.0598 -2.5178 3.11 0.75
##
## Sample Size Used: 74
##
##
## Simulations: 1000
##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.26654 -0.02855 0.60 0.07 .
## ADE -0.26048 -0.75091 0.21 0.30
## Total Effect 0.00606 -0.57329 0.56 0.99
## Prop. Mediated 0.23208 -19.96642 14.98 0.95
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 74
##
##
## Simulations: 1000
social relevance